home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 020a / intgif11.zip / INTGIF11.PAS < prev    next >
Pascal/Delphi Source File  |  1990-07-20  |  10KB  |  443 lines
  1. {-------------------------------------------------------------------------}
  2. {                                                                         }
  3. { IntGIF v.1.1  -  Copyright (c) EUROPA Software, 1990  - August 11       }
  4. {                                                                         }
  5. {-------------------------------------------------------------------------}
  6.  
  7.  
  8. program IntGIF11;
  9.  
  10.    uses dos,crt,param,gifunit;
  11.  
  12.  
  13.    var cl  :  ParamArray;
  14.  
  15.    procedure ShowUsage;
  16.  
  17.       begin
  18.  
  19.          write('Usage is: IntGIF [Options] [Filespec]' + crlf  + crlf );
  20.          write('      Options Are: /H = This Help Screen'    + crlf + crlf );
  21.          write('                   /E = Extensive Details       ─╖   '   + crlf );
  22.          write('                   /M = Medium Details           ╟─  Choose Only One'   + crlf );
  23.          write('              +    /L = Limited Details         ─╜  '   + crlf + crlf );
  24.          write('                   /T = Truncate Extra Bytes    ─╖ '   + crlf );
  25.          write('              +    /S = Show Extras But Ignore   ╟─  Choose Only One'   + crlf );
  26.          write('                   /I = Ignore Extra Bytes      ─╜ '   + crlf + crlf);
  27.          write('              -    /R = Recurse Directories     '   + crlf + crlf );
  28.          write('                   Default Filespec:  *.gif' + crlf + crlf);
  29.          write('                   "/" or "-" May Be Used to Signal An Option' );
  30.  
  31.          halt(1);
  32.  
  33.       end;
  34.  
  35.  
  36.  
  37.    procedure SetParams;
  38.  
  39.       var st   :  array[1..5] of string;
  40.           i,j  :  byte;
  41.  
  42.       begin
  43.  
  44.          recurse := false;
  45.          path    := '*.gif';
  46.          Detail  := Short;
  47.          Extra   := Medium;
  48.  
  49.  
  50.          for i := 1 to cl.SwitchCount do
  51.  
  52.              case cl.Switch[i][1] of
  53.  
  54.                   'R', 'r'  :  recurse := true;
  55.                   'H', 'h'  :  showUsage;
  56.                   'E', 'e'  :  Detail := Extensive;
  57.                   'M', 'm'  :  Detail := Medium;
  58.                   'L', 'l'  :  Detail := Short;
  59.                   'T', 't'  :  Extra  := Extensive;
  60.                   'S', 's'  :  Extra  := Medium;
  61.                   'I', 'i'  :  Extra  := Short;
  62.                   else begin
  63.  
  64.                           write(crlf + 'Unknown Switch in Command Line:  -' +
  65.                                        cl.Switch[i][1] + crlf + crlf);
  66.  
  67.  
  68.                           ShowUsage;
  69.                           halt(1);
  70.  
  71.                   end;
  72.  
  73.              end;
  74.  
  75.  
  76.          BSize := Sizes[Detail];
  77.  
  78.          if cl.SpecCount > 0 then Path := cl.Spec[1];
  79.  
  80.       end;
  81.  
  82.  
  83.    procedure ExtensionBlockResults( z  :  byte );
  84.  
  85.       begin
  86.  
  87.          writeln(crlf + 'Extension Block Function Code: ', z, ' Requested.');
  88.  
  89.       end;
  90.  
  91.  
  92.  
  93.    {$F+}
  94.  
  95.    procedure OurExitProc;
  96.  
  97.       begin
  98.  
  99.          writeln;
  100.          close(output);
  101.          chdir(StartDir);
  102.          ExitProc := SaveExitProc;
  103.          halt(0);
  104.  
  105.       end;
  106.  
  107.    {$F-}
  108.  
  109.  
  110.    procedure OneHeading;
  111.  
  112.       const Head  :  array[1..2] of string =
  113.  
  114.             (( ' Filename    Horz Vert Col  Global Map  ' +
  115.                ' Color Res.  Date Stamp  File Size' + crlf +
  116.                ' --------    ---- ---- ---  ----------  ' +
  117.                ' ----------  ----------  ---------'               ),
  118.  
  119.              ( ' Filename    Horz Vert Col  Global Map  ' +
  120.                ' Color Res.    Images   Lace  LZW Bytes' + crlf +
  121.                ' --------    ---- ---- ---  ----------  ' +
  122.                ' ----------    ------   ----  ---------'          ));
  123.  
  124.       begin
  125.  
  126.          case Detail of
  127.  
  128.               1,3 : write( crlf + Head[1] + crlf );
  129.               2   : write( crlf + Head[2] + crlf );
  130.  
  131.          end;
  132.  
  133.       end;
  134.  
  135.  
  136.  
  137.  
  138.    procedure ScreenResults;
  139.  
  140.       begin
  141.  
  142.          if (Detail = 3) OR (TotalFiles = 0) then OneHeading;
  143.  
  144.          write( pad(p^.name,12) );
  145.          write( rightstr(GH.RWidth,5),
  146.                 rightstr(GH.RHeight,5),
  147.                 rightstr(1 shl GH.GBitsPerPixel, 4), '   ');
  148.  
  149.          if GH.GlobalColorMap = 1 then write('Glob. Map  ' )
  150.          else                          write('No Glob.   ' );
  151.  
  152.          write( GH.GBitsPerPixel:2, ' Bits/Pix' );
  153.  
  154.          case Detail of
  155.  
  156.               1,3: write( '   ', gooddate, '   ', rightstr(p^.Size,9), crlf );
  157.  
  158.          end;
  159.  
  160.       end;
  161.  
  162.  
  163.    procedure ImageResults;
  164.  
  165.       begin
  166.  
  167.          write( rightstr( ImageNumber,25 ));
  168.          write( rightstr( GH.LeftOfs, 7 ));
  169.          write( rightstr( GH.TopOfs,  5 ));
  170.          write( rightstr( GH.IWidth,  7 ));
  171.          write( rightstr( GH.IHeight, 6 ));
  172.  
  173.          write( '   ' + NoYo[GH.LocalColorMap] );
  174.          write( '   ' + NoYo[GH.Interlace] );
  175.  
  176.          write( rightstr( ImageBytes, 12) + crlf );
  177.  
  178.       end;
  179.  
  180.  
  181.  
  182.    procedure TotalResults;
  183.  
  184.       begin
  185.  
  186.          case Detail of
  187.  
  188.               2: begin
  189.  
  190.                     write( '  ', ImageNumber:2, ' Image' );
  191.  
  192.                     if ImageNumber > 1 then write('s  ') else write('   ');
  193.  
  194.                     write(NoYo[GH.Interlace]+rightstr(p^.Size,10)+crlf );
  195.  
  196.                   end;
  197.  
  198.                3: begin
  199.  
  200.                      blank(65); write( '---------' + crlf);
  201.                      blank(65); write( rightstr(TotalLZW, 9) + crlf + crlf);
  202.  
  203.                   end;
  204.  
  205.          end;
  206.  
  207.       end;
  208.  
  209.  
  210.  
  211.  
  212.    procedure listfiles;
  213.  
  214.       const offx = '                       ';
  215.  
  216.             IHead = crlf + '            ' +
  217.             'Image Data  #  Left+  Top+  Horz  Vert  Local  Lace  LZW Bytes' + crlf +
  218.                offx +  '--  -----  ----  ----  ----  -----  ----  ---------' + crlf;
  219.  
  220.       var i     :  word;
  221.           WDir  :  string;
  222.  
  223.       begin
  224.  
  225.          getdir(0, WDir);
  226.          
  227.  
  228.          write('Processing Directory: ', WDir, ' ... ' );
  229.          BufIdx := GetNames;
  230.  
  231.          if BufIdx = 0 then begin
  232.  
  233.             writeln('No Files Found!');
  234.             exit;
  235.  
  236.          end
  237.          else begin
  238.  
  239.             write(BufIdx, ' File');
  240.             if BufIdx > 1 then writeln('s.') else writeln('.');
  241.  
  242.          end;
  243.  
  244.  
  245.  
  246.          p := FileHead;
  247.          TotalFiles := 0;
  248.          NotGIFs    := 0;
  249.  
  250.          repeat
  251.  
  252.             Assign( giffile, p^.name );
  253.             Reset(  giffile, 1 );
  254.  
  255.             TotalBufIdx := 0;
  256.             FileEnd     := FileSize(GIFFile);
  257.             FillBuffer;
  258.  
  259.             ReadScreenDescriptor;
  260.  
  261.  
  262.             if IsAGIF then begin
  263.  
  264.                ScreenResults;
  265.  
  266.                inc(TotalFiles);
  267.                ControlCode := GetByte;
  268.                ImageNumber := 0;
  269.                TotalLZW    := 0;
  270.  
  271.  
  272.                while (ControlCode <> GIFTerminator) AND
  273.                      (NOT (AtEOF) AND
  274.                      ( Detail > 1 )) do begin
  275.  
  276.                      case ControlCode of
  277.  
  278.                           33: SkipExtensionBlock;
  279.                           44: begin
  280.  
  281.                                  if (TotalLZW = 0) AND
  282.                                     (Detail = 3) then write( IHead );
  283.  
  284.                                  ReadImageDescriptor;
  285.  
  286.                                  TermByte   := getbyte;
  287.                                  ImageBytes := 0;
  288.  
  289.                                  repeat
  290.  
  291.                                     BlockSize := GetByte;
  292.  
  293.                                     if BufIdx+256 < BufEnd then inc(BufIdx, BlockSize)
  294.                                     else for i := 1 to BlockSize do TermByte := GetByte;
  295.  
  296.                                     inc(ImageBytes, BlockSize);
  297.  
  298.                                  until ((blocksize = 0) OR (AtEOF));
  299.  
  300.                                  if Detail = 3 then ImageResults;
  301.                                  inc(TotalLZW, ImageBytes);
  302.  
  303.                               end;
  304.  
  305.                           else write('Bad Code in file - Possibly Corrupt !');
  306.  
  307.                      end;
  308.  
  309.                      ControlCode := GetByte;
  310.  
  311.                end;
  312.  
  313.                TotalResults;
  314.  
  315.             end
  316.             else inc(NotGIFs);
  317.  
  318.             close(GIFFile);
  319.             p := p^.next;
  320.  
  321.          until (p = NIL);
  322.  
  323.          repeat
  324.  
  325.             p := FileHead^.next;
  326.             dispose(FileHead);
  327.             FileHead := p;
  328.  
  329.          until p = NIL;
  330.  
  331.          if (TotalFiles - NotGIFs) > 0 then writeln;
  332.  
  333.       end;
  334.  
  335.  
  336.  
  337.    Procedure NextDir;
  338.  
  339.       var SRec       :  SearchRec;
  340.           MyDir      :  string[12];
  341.  
  342.       Begin
  343.  
  344.          FindFirst('*.*',AnyFile,SRec);
  345.  
  346.          while DosError = 0 do begin
  347.  
  348.                If (SRec.Attr = Directory) and (SRec.Name[1] <> '.') then begin
  349.  
  350.                   ChDir(SRec.Name);
  351.                   MyDir := SRec.Name;
  352.                   listfiles;
  353.                   NextDir;
  354.                   ChDir('..');
  355.  
  356.                end;
  357.  
  358.                FindNext(SRec);
  359.  
  360.          end;
  361.  
  362.  
  363.       End;
  364.  
  365.  
  366.  
  367.  
  368.    begin
  369.  
  370.  
  371.       SaveExitProc := ExitProc;
  372.       ExitProc     := @OurExitProc;
  373.       TotalFiles   := 0;
  374.       NotGIFs      := 0;
  375.       recurse      := false;
  376.  
  377.       getdir(0,StartDir);
  378.  
  379.       writeln('IntGIF v.1.1  -  GIF Image Interrogator');
  380.       writeln('Copyright (c) 1990,  EUROPA Software [jec]' + crlf);
  381.  
  382.  
  383.       if ParseCommandLine( cl ) then SetParams
  384.       else begin
  385.  
  386.          writeln('Error in Command Line');
  387.          halt(1);
  388.  
  389.       end;
  390.  
  391.  
  392.       if Path = '' then begin
  393.  
  394.          write( 'Enter GIF Filename to Interrogate: ');
  395.          Readln( Path );
  396.  
  397.       end;
  398.  
  399.       assign(output,'');
  400.       rewrite(output);
  401.       fsplit(path, D, N, E);
  402.  
  403.       path := D;
  404.       mask := N + E;
  405.  
  406.       {$I-}
  407.  
  408.  
  409.       If Path[length(Path)] = '\' then Path[Length(Path)] := ' ';
  410.  
  411.       if length(path) > 1 then
  412.          If Path[Length(Path)-1] = ':' then Path[Length(Path)] := '\';
  413.  
  414.       {$I-}
  415.  
  416.       ChDir(Path);
  417.  
  418.       If IOResult <> 0 then Begin
  419.  
  420.          writeln('  ',Path,' is not a valid directory.');
  421.          writeln;
  422.          ChDir(StartDir);
  423.          halt(1);
  424.  
  425.       end;
  426.  
  427.       {$I+}
  428.  
  429.       GetDir(0,CurrentDir);
  430.  
  431.       new(buf);
  432.  
  433.       listfiles;
  434.  
  435.       if recurse then NextDir;
  436.  
  437.       dispose(buf);
  438.  
  439.       ChDir(StartDir);
  440.  
  441.    end.
  442.  
  443.